home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / lib / perl5 / YAML / XS.pm < prev   
Encoding:
Perl POD Document  |  2010-04-14  |  5.0 KB  |  204 lines

  1. # ToDo:
  2. #
  3. # - Load globs
  4. # - Dump *foo{IO} and *foo{FORMAT}
  5. # - Rewrite documentation
  6. # - Copy all relevant code from YAML::Syck
  7. #   - Review YAML::Syck Changes file
  8. # - Make YAML a prereq for YAML-LibYAML
  9. # - Make loading regexp use code from YAML::Types
  10. # - Make glob dumping use YAML::Node
  11. # - Move all YAML and YAML::XS tests to YAML::Tests
  12. #   - Make YAML and YAML::XS pass all common tests
  13. # - Add scalar dumping heuristics similar to YAML.pm
  14. #
  15. # Tests:
  16. # - Abstract all tests to YAML::Tests
  17. # - http://svn.ali.as/cpan/concept/cpan-yaml-tiny/
  18. #
  19. # Profiling:
  20. # - TonyC: sprof if I can remember the way to enable shared library profiling
  21. # - TonyC: LD_PROFILE, but that may not work on OS X
  22. # - TonyC: sample or Sampler.app on OS X, I'd guess
  23.  
  24.  
  25. package YAML::XS;
  26. use 5.008003;
  27. use strict;
  28. $YAML::XS::VERSION = '0.33';
  29. use base 'Exporter';
  30.  
  31. @YAML::XS::EXPORT = qw(Load Dump);
  32. @YAML::XS::EXPORT_OK = qw(LoadFile DumpFile);
  33. %YAML::XS::EXPORT_TAGS = (
  34.     all => [qw(Dump Load LoadFile DumpFile)],
  35. );
  36. # $YAML::XS::UseCode = 0;
  37. # $YAML::XS::DumpCode = 0;
  38. # $YAML::XS::LoadCode = 0;
  39.  
  40. use YAML::XS::LibYAML qw(Load Dump);
  41.  
  42. sub DumpFile {
  43.     my $OUT;
  44.     my $filename = shift;
  45.     if (ref $filename eq 'GLOB') {
  46.         $OUT = $filename;
  47.     }
  48.     else {
  49.         my $mode = '>';
  50.         if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) {
  51.             ($mode, $filename) = ($1, $2);
  52.         }
  53.         open $OUT, $mode, $filename
  54.           or die "Can't open '$filename' for output:\n$!";
  55.     }
  56.     local $/ = "\n"; # reset special to "sane"
  57.     print $OUT YAML::XS::LibYAML::Dump(@_);
  58. }
  59.  
  60. sub LoadFile {
  61.     my $IN;
  62.     my $filename = shift;
  63.     if (ref $filename eq 'GLOB') {
  64.         $IN = $filename;
  65.     }
  66.     else {
  67.         open $IN, $filename
  68.           or die "Can't open '$filename' for input:\n$!";
  69.     }
  70.     return YAML::XS::LibYAML::Load(do { local $/; <$IN> });
  71. }
  72.  
  73. # XXX Figure out how to lazily load this module. 
  74. # So far I've tried using the C function:
  75. #      load_module(PERL_LOADMOD_NOIMPORT, newSVpv("B::Deparse", 0), NULL);
  76. # But it didn't seem to work.
  77. use B::Deparse;
  78.  
  79. # XXX The following code should be moved from Perl to C.
  80. $YAML::XS::coderef2text = sub {
  81.     my $coderef = shift;
  82.     my $deparse = B::Deparse->new();
  83.     my $text;
  84.     eval {
  85.         local $^W = 0;
  86.         $text = $deparse->coderef2text($coderef);
  87.     };
  88.     if ($@) {
  89.         warn "YAML::XS failed to dump code ref:\n$@";
  90.         return;
  91.     }
  92.     $text =~ s[BEGIN \{\$\{\^WARNING_BITS\} = "UUUUUUUUUUUU\\001"\}]
  93.               [use warnings;]g;
  94.  
  95.     return $text;
  96. };
  97.  
  98. $YAML::XS::glob2hash = sub {
  99.     my $hash = {};
  100.     for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
  101.         my $value = *{$_[0]}{$type};
  102.         $value = $$value if $type eq 'SCALAR';
  103.         if (defined $value) {
  104.             if ($type eq 'IO') {
  105.                 my @stats = qw(device inode mode links uid gid rdev size
  106.                                atime mtime ctime blksize blocks);
  107.                 undef $value;
  108.                 $value->{stat} = {};
  109.                 map {$value->{stat}{shift @stats} = $_} stat(*{$_[0]});
  110.                 $value->{fileno} = fileno(*{$_[0]});
  111.                 {
  112.                     local $^W;
  113.                     $value->{tell} = tell(*{$_[0]});
  114.                 }
  115.             }
  116.             $hash->{$type} = $value;
  117.         }
  118.     }
  119.     return $hash;
  120. };
  121.  
  122. use constant _QR_MAP => {
  123.     '' => sub { qr{$_[0]} },
  124.     x => sub { qr{$_[0]}x },
  125.     i => sub { qr{$_[0]}i },
  126.     s => sub { qr{$_[0]}s },
  127.     m => sub { qr{$_[0]}m },
  128.     ix => sub { qr{$_[0]}ix },
  129.     sx => sub { qr{$_[0]}sx },
  130.     mx => sub { qr{$_[0]}mx },
  131.     si => sub { qr{$_[0]}si },
  132.     mi => sub { qr{$_[0]}mi },
  133.     ms => sub { qr{$_[0]}sm },
  134.     six => sub { qr{$_[0]}six },
  135.     mix => sub { qr{$_[0]}mix },
  136.     msx => sub { qr{$_[0]}msx },
  137.     msi => sub { qr{$_[0]}msi },
  138.     msix => sub { qr{$_[0]}msix },
  139. };
  140.  
  141. sub __qr_loader {
  142.     if ($_[0] =~ /\A  \(\?  ([ixsm]*)  (?:-  (?:[ixsm]*))?  : (.*) \)  \z/x) {
  143.         my $sub = _QR_MAP->{$1} || _QR_MAP->{''};
  144.         &$sub($2);
  145.     }
  146.     else {
  147.         qr/$_[0]/;
  148.     }
  149. }
  150.  
  151. 1;
  152.  
  153. =encoding utf8
  154.  
  155. =head1 NAME
  156.  
  157. YAML::XS - Perl YAML Serialization using XS and libyaml
  158.  
  159. =head1 SYNOPSIS
  160.  
  161.     use YAML::XS;
  162.  
  163.     my $yaml = Dump [ 1..4 ];
  164.     my $array = Load $yaml;
  165.  
  166. =head1 DESCRIPTION
  167.  
  168. Kirill Siminov's C<libyaml> is arguably the best YAML implementation.
  169. The C library is written precisely to the YAML 1.1 specification. It was
  170. originally bound to Python and was later bound to Ruby.
  171.  
  172. This module is a Perl XS binding to libyaml which offers Perl the best YAML
  173. support to date.
  174.  
  175. This module exports the functions C<Dump> and C<Load>. These functions
  176. are intended to work exactly like C<YAML.pm>'s corresponding functions.
  177.  
  178. =head1 SEE ALSO
  179.  
  180.  * YAML.pm
  181.  * YAML::Syck
  182.  * YAML::Tiny
  183.  
  184. =head1 AUTHOR
  185.  
  186. Ingy d├╢t Net <ingy@cpan.org>
  187.  
  188. =head1 MAINTAINERS
  189.  
  190. Yuval Kogman <nothingmuch@woobling.org>
  191.  
  192. Gisle Aas <gisle@ActiveState.com>
  193.  
  194. =head1 COPYRIGHT
  195.  
  196. Copyright (c) 2007, 2008, 2009, 2010. Ingy d├╢t Net.
  197.  
  198. This program is free software; you can redistribute it and/or modify it
  199. under the same terms as Perl itself.
  200.  
  201. See http://www.perl.com/perl/misc/Artistic.html
  202.  
  203. =cut
  204.